home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / fb386 / pickup / narcisst.bas < prev    next >
BASIC Source File  |  1991-10-18  |  9KB  |  209 lines
  1. 1 KEY (1) ON :ON KEY (1) GOSUB 65010:PLAY OFF
  2. 10 '
  3. 20 '　Ａ　Ｃｒａｚｙ　Ｎａｒｃｉｓｓｉｓｔ　／　by Kazuya Shimada
  4. 30 '
  5. 40 PLAY OFF:LOAD@"PDRUMS.PMB":LOAD@"Q:\FJ\FM\FM_1.FMB"
  6. 50 DIM T%(4,9),V%(23),D%(47)
  7. 60 '----------------------------------------------------------------
  8. 70 TNO%=1 : TNAME$="MAIN 1"
  9. 80 FOR Y%=0 TO 4 : FOR X%=0 TO 9:READ T%(Y%,X%):NEXT:NEXT:GOSUB *TNCONV
  10. 90 '    AF  OM  WF  SY   SP   PMD AMD PMS
  11. 100 DATA 56, 15,  0,  0,     0,  0,  0,  0,  0,  0
  12. 110 '    AR  DR  SR  RR  SL  TL  KS  ML  DT AMS
  13. 120 DATA 31,  0,  0,  6,  1, 24,  1,  7,  1,  0
  14. 130 DATA 31,  0,  0,  6,  0, 31,  1,  1,  1,  0
  15. 140 DATA 31,  0,  0,  6,  0, 31,  1,  1,  1,  0
  16. 150 DATA 31,  7,  6,  6,  2,  0,  1,  2,  4,  0
  17. 160 '----------------------------------------------------------------
  18. 170 TNO%=2 : TNAME$="BASS"
  19. 180 FOR Y%=0 TO 4 : FOR X%=0 TO 9:READ T%(Y%,X%):NEXT:NEXT:GOSUB *TNCONV
  20. 190 '    AF  OM  WF  SY   SP   PMD AMD PMS
  21. 200 DATA 16, 15,  0,  0,     0,  0,  0,  0,  0,  0
  22. 210 '    AR  DR  SR  RR  SL  TL  KS  ML  DT AMS
  23. 220 DATA 31, 18,  0,  6,  2, 48,  0, 10,  0,  0
  24. 230 DATA 31, 14,  4,  6,  2, 25,  0,  0,  7,  0 
  25. 240 DATA 31, 10,  4,  6,  2, 19,  1,  0,  3,  0
  26. 250 DATA 31,  8,  3,  6,  2,  3,  1,  0,  0,  0
  27. 260 '----------------------------------------------------------------
  28. 270 GOSUB 1030
  29. 280 GOTO 420
  30. 290 *TNCONV
  31. 300 FOR I%=0 TO 3:J%=I%+1:D%(8+I%)=(T%(J%,8)AND 7)*16+(T%(J%,7)AND 15)
  32. 310 D%(12+I%)=(T%(J%,5) AND 127)
  33. 320 D%(16+I%)=(T%(J%,6) AND   3)*64+(T%(J%,0) AND 31)
  34. 330 D%(20+I%)= T%(J%,1) AND  31:D%(24+I%)=T%(J%,2) AND 31
  35. 340 D%(28+I%)=(T%(J%,4) AND  15)*16+(T%(J%,3) AND 15):NEXT
  36. 350 D%(32)=T%(0,0):D%(33)=&HC0+((T%(0,7) AND 3)*16)+((T%(0,8) AND 7))
  37. 360 A$=LEFT$(TNAME$+"        ",8)
  38. 370 FOR I%=0 TO 7:D%(I%)=ASC(MID$(A$,I%+1,1)):NEXT
  39. 380 FOR I%=0 TO 47 STEP 2:L&=D%(I%+1)*256+D%(I%)
  40. 390 IF L&<&H8000 THEN V%(I% \ 2)=CINT(L&) ELSE V%(I% \ 2)=CINT(L&-&H10000)
  41. 400 NEXT:VOICE TNO%,V%:RETURN
  42. 410 '----------------------------------------------------------------
  43. 420 FOR I=0 TO 13:PART I,I:NEXT
  44. 430 T$="T125Q8L8%CU0"
  45. 440 PLAY T$,T$,T$,T$,T$,T$,T$,T$,T$,T$,T$,T$,T$,T$
  46. 450 G0$="@3V15L12O4ARARARAR"
  47. 460 G0A$="U360@3V15L12O3ARARARAR"
  48. 470 H0$="@2%RV15L12O3RRERL24EEEEEEEE"
  49. 480 H0A$="U360@2%LV15L12O3RRERL24EEEEEEEE"
  50. 490 A1$="@1%CV8L8O4CDFEC16DF.E16C16 D16GD16&D2."
  51. 500 B1$="U80@1%CV8L8O4CDFEC16DF.E16C16 D16GD16&D2."
  52. 510 C1$="U40@1%CV8L8R1 R1"
  53. 520 F1$="@2V13L16O3(CCCC)4 <(B-B-B-B-)4"
  54. 530 G1$="L8O3((ARAR)2)2"
  55. 540 G1A$="L8O4((ARAR)2)2"
  56. 550 G2$="O3(ARAR)3ARAA"
  57. 560 G2B$="O4(ARAR)3ARAA"
  58. 570 H1$="L8O4((RERE)2)2"
  59. 580 H1A$="L8O4((RERE)2)2"
  60. 590 H1B$="O4(RERE)3REL16REL32EEEEL8"
  61. 600 I1$="@4V15L16O5((AAAA)4)2"
  62. 610 I1A$="U360@4V15L16O5((AAAA)4)2"
  63. 620 J1$="@14%RV8L8O4CDFEC16DF.E16C16 D16GD16&D2."
  64. 630 K1$="U120@14%LV8L8O4CDFEC16DF.E16C16 D16GD16&D2."
  65. 640 A2$="%RV10L16O4EEEE8EE8F8EC8CD8 EEEE8EE8G8FC8CD8"
  66. 650 B2$="%LV10L16O4EEEE8EE8F8EC8CD8 EEEE8EE8G8FC8CD8"
  67. 660 C2$="L16O4E32&EEEE8EE8F8EC8CD8 EEEE8EE8G8FC8CD."
  68. 670 F2$="L16O2(A-A-A-A-A-A-B->C<) (A-A-A-A-A-A-B->C-<)"
  69. 680 A3$="%RV10L16O4E-E-E-E-8E-E-8F8E-C8CD8 E-E-E-E-8E-E-8G-8FC8CD8"
  70. 690 B3$="%LV10L16O4E-E-E-E-8E-E-8F8E-C8CD8 E-E-E-E-8E-E-8G-8FC8CD8"
  71. 700 C3$="L16O4E-32&E-E-E-E-8E-E-8F8E-C8CD8 E-E-E-E-8E-E-8G-8FC8CD."
  72. 710 A4$="O4E-DCE-DCE-DFE-DFE-DFE- GFE-GFE-GF A-GFA-GFA-G"
  73. 720 B4$="O4E-DCE-DCE-DFE-DFE-DFE- GFE-GFE-GF A-GFA-GFA-G"
  74. 730 C4$="O4E-32&E-DCE-DCE-DFE-DFE-DFE- GFE-GFE-GF A-GFA-GFA-G32"
  75. 740 F4$="O3CCCCCCCCDDDDDDDD E-E-E-E-E-E-E-E-FFFFFFFF"
  76. 750 J4$="L16O4E-DCE-DCE-DFE-DFE-DFE- GFE-GFE-GF A-GFA-GFA-G"
  77. 760 A5$="O5CCCC<B-B-B-B-A-A-A-A-GGGG FFE-E-DDE-E-FFGGA-A-B-B-"
  78. 770 B5$="O5CCCC<B-B-B-B-A-A-A-A-GGGG FFE-E-DDE-E-FFGGA-A-B-B-"
  79. 780 C5$="O5C32&CCCC<B-B-B-B-A-A-A-A-GGGG FFE-E-DDE-E-FFGGA-A-B-B-32"
  80. 790 F5$="O2A->A-<A->A-<G>G<G>G<F>F<F>F<E->E-<E->E- <D>D<C>C<<B->B-C>C<D>D<E->E-<F>F<G>G"
  81. 800 H5$="O4(L16REEEREEEL8)2 (RERE)2"
  82. 810 J5$="O5CCCC<B-B-B-B-A-A-A-A-GGGG FFE-E-DDE-E-FFGGA-A-B-B-"
  83. 820 A6$="L1O5C4R2. R"
  84. 830 B6$="L1O5C4R2. R"
  85. 840 C6$="L1O5C32&C4R2. R2..."
  86. 850 F6$="O2(A-A-A-A-A-A-A-A-)2 (GGGGGGGG)2"
  87. 860 G6$="O3(ARAR)3ARRR"
  88. 870 G6B$="O4(ARAR)3ARRR"
  89. 880 H6$="O4(RERE)3L32EEEEEEEEEEEEEEEE"
  90. 890 J6$="L1O5C R"
  91. 900 PLAY A0$,B0$,C0$,D0$,E0$,F0$,G0$,G0A$,H0$,H0A$,I0$,J0$,K0$
  92. 910 PLAY A1$,B1$,C1$,D1$,E1$,F1$,G1$,G1A$,H1$,H1A$,I1$,I1A$,J1$,K1$
  93. 920 PLAY A1$,B1$,C1$,D1$,E1$,F1$,G2$,G2B$,H1B$,H1B$,I1$,I1$,J1$,K1$
  94. 930 PLAY A2$,B2$,C2$,D2$,E2$,F2$,G1$,G1A$,H1$,H1A$,I1$,I1$,J2$,J2$
  95. 940 PLAY A2$,B2$,C2$,D2$,E2$,F2$,G1$,G1A$,H1$,H1A$,I1$,I1$,J2$,J2$
  96. 950 PLAY A1$,B1$,C1$,D1$,E1$,F1$,G1$,G1A$,H1$,H1A$,I1$,I1$,J1$,K1$
  97. 960 PLAY A1$,B1$,C1$,D1$,E1$,F1$,G2$,G2B$,H1B$,H1B$,I1$,I1$,J1$,K1$
  98. 970 PLAY A3$,B3$,C3$,D3$,E3$,F2$,G1$,G1A$,H1$,H1A$,I1$,I1$,J3$,J3$
  99. 980 PLAY A3$,B3$,C3$,D3$,E3$,F2$,G1$,G1A$,H1$,H1A$,I1$,I1$,J3$,J3$
  100. 990 PLAY A4$,B4$,C4$,D4$,E4$,F4$,G1$,G1A$,H1$,H1A$,I1$,I1$,J4$,J4$
  101. 1000 PLAY A5$,B5$,C5$,D5$,E5$,F5$,G1$,G1A$,H5$,H5$,I1$,I1$,J5$,J5$
  102. 1010 PLAY A6$,B6$,C6$,D6$,E6$,F6$,G6$,G6B$,H6$,H6$,I1$,I1$,J6$,J6$
  103. 1020 GOTO 910
  104. 1030 '
  105. 1040 GOSUB *SCREEN
  106. 1260 I$=INKEY$:IF I$="" THEN 1260
  107. 1270 GOSUB *F_OUT : SCREEN@ 1:CLS
  108. 1280 PASTEL 127
  109. 1290 FOR I=0 TO 239
  110. 1300 LINE(0,I)-(319,I),PSET,[127,RND*255,127]
  111. 1310 NEXT
  112. 1320 FOR I=1 TO 55
  113. 1330 X=RND*320:Y=RND*320:R=RND*40
  114. 1340 CIRCLE(X,Y),R,0,,,,F
  115. 1350 NEXT
  116. 1360 PASTEL 192
  117. 1370 FOR I=1 TO 250
  118. 1380 X=RND*320:Y=RND*320
  119. 1390 IF POINT(X,Y)<>0 THEN 1380
  120. 1400 C=RND*6+1
  121. 1410 PSET(X,Y),C,PASTEL
  122. 1420 NEXT
  123. 1430 PASTEL 192
  124. 1440 FOR I=1 TO 30
  125. 1450 X=RND*320:Y=RND*320:H=RND*32:C=RND*6+1
  126. 1460 LINE(X,Y)-(X+H,Y+H),PASTEL,C,BF
  127. 1470 NEXT
  128. 1480 SYMBOL(15,199),"A Crazy Narcissist",2,2,1
  129. 1490 SYMBOL(17,199),"A Crazy Narcissist",2,2,1
  130. 1500 SYMBOL(15,201),"A Crazy Narcissist",2,2,1
  131. 1510 SYMBOL(17,201),"A Crazy Narcissist",2,2,1
  132. 1520 SYMBOL(16,200),"A Crazy Narcissist",2,2,5
  133. 1530 FOR I=0 TO 5000:NEXT
  134. 1540 RETURN
  135. 17000 *SCREEN
  136. 17010 SCREEN@ 0 : PALETTE@
  137. 17020 FOR I=0 TO 15 : PALETTE I,[0,0,0] : NEXT
  138. 17030 COLOR ,%5 : CLS
  139. 17040 X=630 : Y=30 : MX=2 : MY=3: R=3 : C1=1 : C2=5 : C3=15 : F=16
  140. 17050 ST$="ＰＩＣＫ　ＵＰ　ＴＯＷＮＳ" : GOSUB *STR_PUT
  141. 17060 X=575 : Y=30 : MX=2 : MY=3 : R=3 : C1=1 : C2=5 : C3=15 : F=16
  142. 17070 ST$="ＭＵＳＩＣ　ＰＲＯＧＲＡＭ" : GOSUB *STR_PUT
  143. 17080 GOSUB *F_IN : FOR I=0 TO 2000 : NEXT
  144. 17090 X1=10 : X2=510 : Y1=10 : Y2=460 : C1=1 : C2=6 : C3=15
  145. 17100 GOSUB *WAKU
  146. 17110 X1=20 : X2=500 : Y1=20 : Y2=90 : C1=15 : C2=7 : C3=5
  147. 17120 GOSUB *WAKU
  148. 17130 X1=20 : X2=500 : Y1=420 : Y2=450 : C1=15 : C2=7 : C3=5
  149. 17140 GOSUB *WAKU
  150. 17150 X1=20 : X2=500 : Y1=100 : Y2=410 : C1=15 : C2=7 : C3=5
  151. 17160 GOSUB *WAKU
  152. 17170 SYMBOL (30,430),"ＰＦ１キーを押すと、演奏を中断して音楽ＭＥＮＵに戻ります。",1,1,0,,,1
  153. 17180 SYMBOL (30,30),"　ＴＩＴＬＥ　",1,1,0,0,PSET,17
  154. 17190 SYMBOL (80,53),"Ａ　Ｃｒａｚｙ　Ｎａｒｃｉｓｓｉｓｔ",1,2,0,0,PSET,1
  155. 17200 SYMBOL (30,110),"　ＤＡＴＡ　",1,1,0,0,PSET,17
  156. 17210 SYMBOL (80,140),"Programed by　ＫＡＺＵＹＡ　ＳＨＩＭＡＤＡ",1,1,0,0,PSET,1,1
  157. 17220 SYMBOL (80,160)," Composed by　ＫＡＺＵＹＡ　ＳＨＩＭＡＤＡ",1,1,0,0,PSET,1,1
  158. 17230 SYMBOL (30,200),"　ＭＥＳＳＡＧＥ　",1,1,0,0,PSET,17
  159. 17240 'ST$()="･･････････････････････････････････････････････････････"
  160. 17250 ST$(0)="　うーん。ふと何気なく作ってみたら、もろに  A-JAX ぽく"
  161. 17260 ST$(1)="なってしまった。オーケストラヒットの音を使う時は、なる"
  162. 17270 ST$(2)="べく短い音符を使うのが、通ですね。この曲名、苦心して考"
  163. 17280 ST$(3)="えたのですがどうでしょうか。"
  164. 17290 ST$(4)="リターンキー、または実行キーを押すと演奏が始まります。"
  165. 17300 ST$(5)=""
  166. 17310 ST$(6)="　　　　　　オリジナリティーのある曲を作れー（神の声）"
  167. 17320 ST$(7)="　　　　　　　　　　　ひえぇぇぇぇぇぇぇ。お許しをー。"
  168. 17330 GOSUB *MESSAGE
  169. 17340 RETURN
  170. 17350 *STR_PUT
  171. 17360 SYMBOL (X,Y),ST$,MX,MY,%C1,R,PSET,F
  172. 17370 SYMBOL (X+1,Y),ST$,MX,MY,%C1,R,PSET,F
  173. 17380 SYMBOL (X+2,Y),ST$,MX,MY,%C1,R,PSET,F
  174. 17390 SYMBOL (X+2,Y-1),ST$,MX,MY,%C1,R,PSET,F
  175. 17400 SYMBOL (X+2,Y-2),ST$,MX,MY,%C1,R,PSET,F
  176. 17410 SYMBOL (X,Y-2),ST$,MX,MY,%C3,R,PSET,F
  177. 17420 SYMBOL (X+1,Y-2),ST$,MX,MY,%C3,R,PSET,F
  178. 17430 SYMBOL (X,Y-1),ST$,MX,MY,%C3,R,PSET,F
  179. 17440 SYMBOL (X+1,Y-1),ST$,MX,MY,%C2,R,PSET,F
  180. 17450 RETURN
  181. 17460 *WAKU
  182. 17470 LINE (X1+2,Y1+2)-(X2-2,Y2-2),PSET,%C2,BF
  183. 17480 CONNECT (X1,Y2)-(X1,Y1)-(X2,Y1),%C3
  184. 17490 CONNECT (X1+1,Y2-1)-(X1+1,Y1+1)-(X2-1,Y1+1),%C3
  185. 17500 CONNECT (X1+1,Y2)-(X2,Y2)-(X2,Y1+1),%C1
  186. 17510 CONNECT (X1+2,Y2-1)-(X2-1,Y2-1)-(X2-1,Y1+2),%C1
  187. 17520 RETURN
  188. 17530 *MESSAGE
  189. 17540 FOR I=0 TO 7
  190. 17550   SYMBOL (50,230+20*I),ST$(I),1,1,0,0,PSET,1
  191. 17560 NEXT I
  192. 17570 RETURN
  193. 17580 *F_OUT
  194. 17590 FOR I=16 TO 1 STEP -1 : GOSUB *PALETTE : NEXT I :COLOR ,%0: CLS: RETURN
  195. 17600 *F_IN
  196. 17610 FOR I=1 TO 16 : GOSUB *PALETTE : NEXT I : RETURN
  197. 17620 *PALETTE
  198. 17630 PALETTE 1,[0*I,0*I,1*I]
  199. 17640 PALETTE 2,[1*I,0*I,2*I]
  200. 17650 PALETTE 3,[2*I,1*I,3*I]
  201. 17660 PALETTE 4,[4*I,2*I,6*I]
  202. 17670 PALETTE 5,[8*I,6*I,9*I]
  203. 17680 PALETTE 6,[12*I,10*I,13*I]
  204. 17690 PALETTE 7,[14*I,13*I,15*I]
  205. 17700 PALETTE 15,[15*I,15*I,15*I]
  206. 17710 RETURN
  207. 65000 BGM 0:PLAY "R64":BGM 1
  208. 65010 KEY (1) OFF:PLAY OFF:FOR I=0 TO 13:PART I,I:NEXT:RUN"MENU.BAS"
  209.